home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH12 / SRC / COLOR.BAS < prev    next >
Encoding:
BASIC Source File  |  1997-01-08  |  4.7 KB  |  94 lines

  1. Attribute VB_Name = "Color"
  2. Option Explicit
  3.  
  4. ' Viewing position.
  5. Global EyeX As Single
  6. Global EyeY As Single
  7. Global EyeZ As Single
  8.  
  9. ' Location of light source.
  10. Global Const LightX = 100
  11. Global Const LightY = 500
  12. Global Const LightZ = 1000
  13.  
  14. ' Incident light components.
  15. Global LightIir As Single
  16. Global LightIig As Single
  17. Global LightIib As Single
  18.  
  19. ' Ambient light components.
  20. Global LightIar As Single
  21. Global LightIag As Single
  22. Global LightIab As Single
  23.  
  24. ' Constants for the surfaces.
  25. Global LightKdr As Single   ' Diffuse reflection.
  26. Global LightKdg As Single   ' Diffuse reflection.
  27. Global LightKdb As Single   ' Diffuse reflection.
  28. Global LightKar As Single   ' Ambient light.
  29. Global LightKag As Single   ' Ambient light.
  30. Global LightKab As Single   ' Ambient light.
  31. Global LightKdist As Single ' Distance.
  32. Global LightKs As Single    ' Specular reflection.
  33. Global LightN As Single     ' Specular reflection.
  34.  
  35. Type PALETTEENTRY
  36.     peRed As Byte
  37.     peGreen As Byte
  38.     peBlue As Byte
  39.     peFlags As Byte
  40. End Type
  41. Public Const PC_EXPLICIT = &H2      ' Match to system palette index.
  42. Public Const PC_NOCOLLAPSE = &H4    ' Do not match color existing entries.
  43.  
  44. ' GetDeviceCaps constants.
  45. Global Const RASTERCAPS = 38    ' Raster device capabilities.
  46. Global Const RC_PALETTE = &H100 ' Has palettes.
  47. Global Const NUMRESERVED = 106  ' # reserved entries in palette.
  48. Global Const SIZEPALETTE = 104  ' Size of system palette.
  49.  
  50. #If Win32 Then  ' 32-bit VB.
  51.     Type BITMAP ' 24 bytes
  52.         bmType As Long
  53.         bmWidth As Long
  54.         bmHeight As Long
  55.         bmWidthBytes As Long
  56.         bmPlanes As Integer
  57.         bmBitsPixel As Integer
  58.         bmBits As Long
  59.     End Type
  60.     Global Const BITMAP_SIZE = 24
  61.     Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Integer, ByVal nIndex As Integer) As Integer
  62.     Declare Function ResizePalette Lib "gdi32" (ByVal hPalette As Integer, ByVal nNumEntries As Integer) As Integer
  63.     Declare Function SetPaletteEntries Lib "gdi32" (ByVal hPalette As Integer, ByVal wStartIndex As Integer, ByVal wNumEntries As Integer, lpPaletteEntries As PALETTEENTRY) As Integer
  64.     Declare Function GetPaletteEntries Lib "gdi32" (ByVal hPalette As Integer, ByVal wStartIndex As Integer, ByVal wNumEntries As Integer, lpPaletteEntries As PALETTEENTRY) As Integer
  65.     Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As Integer, ByVal wStartIndex As Integer, ByVal wNumEntries As Integer, lpPaletteEntries As PALETTEENTRY) As Integer
  66.     Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long
  67.     Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Integer, ByVal dwCount As Long, lpBits As Any) As Long
  68.     Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Integer, ByVal dwCount As Long, lpBits As Any) As Long
  69.     Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  70.     Declare Function GetNearestPaletteIndex Lib "gdi32" (ByVal hPalette As Integer, ByVal crColor As Long) As Integer
  71. #Else           ' 16-bit VB.
  72.     Type BITMAP ' 14 bytes
  73.         bmType As Integer
  74.         bmWidth As Integer
  75.         bmHeight As Integer
  76.         bmWidthBytes As Integer
  77.         bmPlanes As String * 1
  78.         bmBitsPixel As String * 1
  79.         bmBits As Long
  80.     End Type
  81.     Global Const BITMAP_SIZE = 14
  82.     Declare Function GetDeviceCaps Lib "GDI" (ByVal hdc As Integer, ByVal nIndex As Integer) As Integer
  83.     Declare Function ResizePalette Lib "GDI" (ByVal hPalette As Integer, ByVal nNumEntries As Integer) As Integer
  84.     Declare Function SetPaletteEntries Lib "GDI" (ByVal hPalette As Integer, ByVal wStartIndex As Integer, ByVal wNumEntries As Integer, lpPaletteEntries As PALETTEENTRY) As Integer
  85.     Declare Function GetPaletteEntries Lib "GDI" (ByVal hPalette As Integer, ByVal wStartIndex As Integer, ByVal wNumEntries As Integer, lpPaletteEntries As PALETTEENTRY) As Integer
  86.     Declare Function GetSystemPaletteEntries Lib "GDI" (ByVal hdc As Integer, ByVal wStartIndex As Integer, ByVal wNumEntries As Integer, lpPaletteEntries As PALETTEENTRY) As Integer
  87.     Declare Function RealizePalette Lib "User" (ByVal hdc As Integer) As Integer
  88.     Declare Function GetBitmapBits Lib "GDI" (ByVal hBitmap As Integer, ByVal dwCount As Long, lpBits As Any) As Long
  89.     Declare Function SetBitmapBits Lib "GDI" (ByVal hBitmap As Integer, ByVal dwCount As Long, lpBits As Any) As Long
  90.     Declare Function GetObject Lib "GDI" (ByVal hObject As Integer, ByVal nCount As Integer, lpObject As Any) As Integer
  91.     Declare Function GetNearestPaletteIndex Lib "GDI" (ByVal hPalette As Integer, ByVal crColor As Long) As Integer
  92. #End If
  93.  
  94.